library(corrplot)
Error in library(corrplot) : there is no package called ‘corrplot’
mydata = read.csv("./ER-DataSet.csv")
mydata 
renamed_data = rename(mydata, 
                       Zip = Zip.Code, PCnty = Primary.County, Dual = Dual.Eligible, 
                       MDC = Major.Diagnostic.Category, EDC = Episode.Disease.Category, 
                      BC = Beneficiaries.with.Condition, 
                      BA = Beneficiaries.with.Admissions, 
                   TIA = Total.Inpatient.Admissions, 
                   TBERV = Beneficiaries.with.ER.Visits, 
                   TERV = Total.ER.Visits)
(renamed_data)

County enrollment missing!

(summary(renamed_data[c("Dual", "BC", "BA", "TIA", "TBERV", "TERV")]) )
       Dual             BC               BA               TIA             TBERV              TERV       
 Dual    :38324   Min.   :  21.0   Min.   :   0.00   Min.   :   0.0   Min.   :   0.00   Min.   :   0.0  
 Non-Dual:60367   1st Qu.:  32.0   1st Qu.:  14.00   1st Qu.:  25.0   1st Qu.:  13.00   1st Qu.:  33.0  
                  Median :  55.0   Median :  25.00   Median :  51.0   Median :  23.00   Median :  69.0  
                  Mean   : 139.1   Mean   :  50.54   Mean   : 111.5   Mean   :  56.41   Mean   : 172.3  
                  3rd Qu.: 120.0   3rd Qu.:  51.00   3rd Qu.: 113.0   3rd Qu.:  51.00   3rd Qu.: 162.0  
                  Max.   :7796.0   Max.   :1788.00   Max.   :4099.0   Max.   :3482.00   Max.   :8977.0  
outlier_out_data = filter(renamed_data, !BC%in% boxplot.stats(BC)$out,
               !BA%in% boxplot.stats(BA)$out,
               !TIA%in% boxplot.stats(TIA)$out,
               !TBERV%in% boxplot.stats(TBERV)$out,
               !TERV%in% boxplot.stats(TERV)$out
               )
plot_ly(outlier_out_data, x = ~Year, y = ~BC,  type = 'box', name = "BC") %>%
  add_trace(y = ~BA, name = "BA") %>%
  add_trace(y = ~TIA, name = "TIA") %>%
  add_trace(y = ~TBERV, name = "TBERV") %>%
  add_trace(y = ~TERV, name = "TERV") %>%
  layout(yaxis = list(title = ''), boxmode = 'group')
'layout' objects don't have these attributes: 'boxmode'
Valid attributes include:
'font', 'title', 'titlefont', 'autosize', 'width', 'height', 'margin', 'paper_bgcolor', 'plot_bgcolor', 'separators', 'hidesources', 'smith', 'showlegend', 'xaxis', 'yaxis', 'ternary', 'scene', 'geo', 'mapbox', 'radialaxis', 'angularaxis', 'direction', 'orientation', 'dragmode', 'hovermode', 'hoverlabel', 'legend', 'annotations', 'shapes', 'images', 'updatemenus', 'sliders', 'calendar', 'barmode', 'bargap', 'mapType'
'layout' objects don't have these attributes: 'boxmode'
Valid attributes include:
'font', 'title', 'titlefont', 'autosize', 'width', 'height', 'margin', 'paper_bgcolor', 'plot_bgcolor', 'separators', 'hidesources', 'smith', 'showlegend', 'xaxis', 'yaxis', 'ternary', 'scene', 'geo', 'mapbox', 'radialaxis', 'angularaxis', 'direction', 'orientation', 'dragmode', 'hovermode', 'hoverlabel', 'legend', 'annotations', 'shapes', 'images', 'updatemenus', 'sliders', 'calendar', 'barmode', 'bargap', 'mapType'
columns = data.frame(renamed_data[ , !names(renamed_data) %in% c("Year", "MDC", "EDC", "Zip", "PCnty", "Dual") ] )
ggpairs(columns )

 plot: [1,1] [===-----------------------------------------------------------------------------]  4% est: 0s 
 plot: [1,2] [======--------------------------------------------------------------------------]  8% est: 9s 
 plot: [1,3] [==========----------------------------------------------------------------------] 12% est: 7s 
 plot: [1,4] [=============-------------------------------------------------------------------] 16% est: 6s 
 plot: [1,5] [================----------------------------------------------------------------] 20% est: 5s 
 plot: [2,1] [===================-------------------------------------------------------------] 24% est: 4s 
 plot: [2,2] [======================----------------------------------------------------------] 28% est: 6s 
 plot: [2,3] [==========================------------------------------------------------------] 32% est: 5s 
 plot: [2,4] [=============================---------------------------------------------------] 36% est: 5s 
 plot: [2,5] [================================------------------------------------------------] 40% est: 4s 
 plot: [3,1] [===================================---------------------------------------------] 44% est: 4s 
 plot: [3,2] [======================================------------------------------------------] 48% est: 4s 
 plot: [3,3] [==========================================--------------------------------------] 52% est: 4s 
 plot: [3,4] [=============================================-----------------------------------] 56% est: 3s 
 plot: [3,5] [================================================--------------------------------] 60% est: 3s 
 plot: [4,1] [===================================================-----------------------------] 64% est: 2s 
 plot: [4,2] [======================================================--------------------------] 68% est: 2s 
 plot: [4,3] [==========================================================----------------------] 72% est: 2s 
 plot: [4,4] [=============================================================-------------------] 76% est: 2s 
 plot: [4,5] [================================================================----------------] 80% est: 2s 
 plot: [5,1] [===================================================================-------------] 84% est: 1s 
 plot: [5,2] [======================================================================----------] 88% est: 1s 
 plot: [5,3] [==========================================================================------] 92% est: 1s 
 plot: [5,4] [=============================================================================---] 96% est: 0s 
 plot: [5,5] [================================================================================]100% est: 0s 
                                                                                                            

corrplot(   cor(renamed_data[c("BC", "BA", "TIA", "TBERV", "TERV")])  )

d_stan = as.data.frame(scale(renamed_data[c("BC", "BA", "TIA", "TBERV", "TERV")]))
res1b = factanal(d_stan, factors = 2, rotation = "none", na.action = na.omit)
res1b$loadings

Loadings:
      Factor1 Factor2
BC     0.925         
BA     0.960  -0.270 
TIA    0.915  -0.200 
TBERV  0.963   0.260 
TERV   0.918   0.273 

               Factor1 Factor2
SS loadings      4.385   0.255
Proportion Var   0.877   0.051
Cumulative Var   0.877   0.928
summary(renamed_data[5])
                                                  MDC       
 Diabetes Mellitus                                  :11416  
 Diseases And Disorders Of The Cardiovascular System:30294  
 Diseases And Disordes Of The Respiratory System    :11329  
 HIV Infection                                      : 1077  
 Mental Diseases And Disorders                      :32481  
 Newborns And Other Neonates                        :   86  
 Substance Abuse                                    :12008  
ax_data = renamed_data
levels(ax_data$MDC) <- c("Diabetes", "Cardiovascular", "Respiratory ", 
        
                                          "HIV", "Mental", "Newborns", "Subtnc-Abuse")
plot_ly(ax_data, x = ~MDC) %>% 
  layout(title = "Frequency of Each Categor", 
         yaxis = list(title = ''), xaxis = list(title = "", tickangle = 45), 
               margin = list(b = 250))
No trace type specified:
  Based on info supplied, a 'histogram' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#histogram
No trace type specified:
  Based on info supplied, a 'histogram' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#histogram
plot_ly(renamed_data, x = ~MDC) %>% 
  layout(title = "Frequency of Each Categor", 
         yaxis = list(title = ''), xaxis = list(title = "", tickangle = 45), 
               margin = list(b = 250))
No trace type specified:
  Based on info supplied, a 'histogram' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#histogram
No trace type specified:
  Based on info supplied, a 'histogram' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#histogram
MDC_Dual = renamed_data[, c("MDC", "Dual")] %>% 
  group_by(MDC, Dual) %>% summarise(n()) 
colnames(MDC_Dual) = c("MDC", "Dual", "Frequency")
levels(MDC_Dual$MDC) <- c("Diabetes", "Cardiovascular", "Respiratory ", 
        
                                          "HIV", "Mental", "Newborns", "Subtnc-Abuse")
plot_ly(MDC_Dual, x = ~MDC, y = ~Frequency, color = ~Dual) %>% 
layout(title = "Frequency vs Dual Eligiblity", 
         yaxis = list(title = ''), xaxis = list(title = "", tickangle = 45), 
               margin = list(b = 250))
No trace type specified:
  Based on info supplied, a 'bar' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#bar
minimal value for n is 3, returning requested palette with 3 different levels
No trace type specified:
  Based on info supplied, a 'bar' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#bar
minimal value for n is 3, returning requested palette with 3 different levels
by_Dual_data = renamed_data[, c("Dual", "BC", "BA", "TIA", "TBERV", "TERV")] %>% 
  group_by(Dual) %>% 
        summarise( BC = sum(BC), BA = sum(BA), 
                   TIA = sum(TIA), 
                   TBERV = sum(TBERV), 
                   TERV = sum(TERV))
t <- list(  family = "sans serif",   size = 14,   color = 'blue')
plot_ly(by_Dual_data, x = ~Dual, y = ~BC,  type = 'bar', name = "BC") %>% 
  add_trace(y = ~BA, name = "BA") %>% 
  add_trace(y = ~TIA, name = "TIA") %>% 
  add_trace(y = ~TBERV, name = "TBERV") %>% 
  add_trace(y = ~TERV, name = "TERV") %>% 
  layout( title = "Population Count", 
          font = t, 
          yaxis = list(title = ''), xaxis = list(title = ""), barmode = 'group') 
ui <- fluidPage( 
  selectInput("categ", "Name of Category",
               c("Diabetes Mellitus" ,
                 "Diseases And Disorders Of The Cardiovascular System", 
                 "Diseases And Disordes Of The Respiratory System", 
                 "HIV Infection", 
                 "Mental Diseases And Disorders",
                 "Newborns And Other Neonates",
                 "Substance Abuse" 
                 )) 
  , # Now outputs
  plotlyOutput("my_plot_name")
  
 
  )
 server <- function(input, output) {
  
  output$my_plot_name <- 
    
    renderPlotly({   
      
    MDC_EDC = renamed_data[, c("MDC", "EDC")] %>%  filter(MDC == input$categ  )
    MDC_EDC <- lapply(MDC_EDC, factor)
    EDC_factor = as.factor( unlist(MDC_EDC[2])  )
    df_EDC = data.frame(table(EDC_factor))
    names(df_EDC) <- c("EDC_Category", "Freq")
    
    plot_ly(df_EDC, x = ~EDC_Category, y = ~Freq, type = 'bar',  insidetextfont = list(color = '#FFFFFF'), hoverinfo = 'text') %>% 
  layout( title = paste("Category: ", input$categ), 
          xaxis = list(title = "", tickangle = 45), yaxis = list(title = ""), 
          margin = list(b = 200), 
          font = t   )
      })
  
 }
 shinyApp(server = server, ui = ui)

Listening on http://127.0.0.1:4860
Ignoring explicitly provided widget ID "10e426fd50fa"; Shiny doesn't use themIgnoring explicitly provided widget ID "10e428ee4343"; Shiny doesn't use them
runApp(list(
  ui = basicPage(
    #h2('The attrubutes to select'),
    checkboxGroupInput("columns","Select Columns",
                       choices = c("BC", "BA", "TIA", "TBERV", "TERV"), inline = T),
    plotlyOutput("my_plot_name")
  ),
  server = function(input, output) {
    output$my_plot_name <- renderPlotly({
      if( length(input$columns) == 0 ){
        plot_ly() %>% layout()
        #dfzero <- by_MDC_data[,c("MDC", "BC")]
        #names(dfzero) <- c("MDC", "BC")
        #plot_ly(dfzero, x = ~MDC, y = ~BC,  type = 'bar', name = "TERV") %>%
        #  layout(title = "Total count of each Categor",
        #      yaxis = list(title = ''), xaxis = list(title = ""), barmode = 'group')
      }
      #if(length(input$columns) == 1){
      #  cols <- c("MDC", input$columns)
      #  df <- data.frame(by_MDC_data[,cols])
      #  names(df) <- c("MDC", "input_col")
      #  plot_ly(df, x = ~MDC, y = ~input_col,  type = 'bar', name = "TERV") %>%
      #    layout(title = "Total count of each Categor",
      #        yaxis = list(title = ''), xaxis = list(title = "", tickangle = -90),
      #        margin = list(b = 200), barmode = 'group')
      #}
      else{
        cols <- c("MDC", input$columns)
        df <- data.frame(by_MDC_data)
        names(df) <- c("MDC", "BC", "BA", "TIA", "TBERV", "TERV")
        df$MDC <- factor(df$MDC, levels = df[["MDC"]])
        p = plot_ly(df,  x = ~MDC,  type = 'bar', name = "BC")   %>% 
          layout( title = "Total count of each Categor",
               yaxis = list(title = ''), xaxis = list(title = "", tickangle = 45),
               margin = list(b = 200),
               barmode = 'group')
        if ("BC" %in% cols){  p = add_trace(p, y = ~BC, name = "BC")}
        if ("BA" %in% cols){  p = add_trace(p, y = ~BA, name = "BA")}
        if ( "TIA" %in% cols){ p = add_trace(p, y = ~TIA, name = "TIA") }
        if ( "TBERV" %in% cols){ p = add_trace(p, y = ~TBERV, name = "TBERV") }
        if ( "TERV" %in% cols){ p = add_trace(p, y = ~TERV, name = "TERV") }
        p
      }
    })
  }
))

Listening on http://127.0.0.1:4860
Ignoring explicitly provided widget ID "10e42252220f"; Shiny doesn't use themNo trace type specified and no positional attributes specifiedNo trace type specified:
  Based on info supplied, a 'scatter' trace seems appropriate.
  Read more about this trace type -> https://plot.ly/r/reference/#scatter
No scatter mode specifed:
  Setting the mode to markers
  Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode
Error in data.frame: object 'by_MDC_data' not foundStack trace (innermost first):
    80: data.frame
    79: "plotly"::"ggplotly" [#39]
    78: func
    77: origRenderFunc
    76: output$my_plot_name
     1: runApp
Error in data.frame: object 'by_MDC_data' not foundStack trace (innermost first):
    80: data.frame
    79: "plotly"::"ggplotly" [#39]
    78: func
    77: origRenderFunc
    76: output$my_plot_name
     1: runApp
detailed_data = read.csv("NewData_Detailed.csv")
detailed_data
selected_columns = detailed_data[, c("Year", "Zip.Code", "County", "Total.Beneficiaries")] %>% 
        rename(Zip = Zip.Code, PCnty = County, TB = Total.Beneficiaries)
joined_data = inner_join(renamed_data, selected_columns)
Joining, by = c("Year", "Zip", "PCnty")
Column `PCnty` joining factors with different levels, coercing to character vector
cnty_poplulation = detailed_data[, c("County",  "Total.Beneficiaries")] %>% 
  group_by(County) %>% summarise(TBC = sum(Total.Beneficiaries)) %>% 
    rename(PCnty = County)
joined_data = inner_join(joined_data, cnty_poplulation)
Joining, by = "PCnty"
Column `PCnty` joining character vector and factor, coercing into character vector
head(joined_data)
by_cnty_data = renamed_data[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")]%>% 
  group_by(PCnty) %>% 
        summarise( BC = sum(BC), BA = sum(BA), 
                   TIA = sum(TIA), 
                   TBERV = sum(TBERV), 
                   TERV = sum(TERV))
(by_cnty_data)
ui <- fluidPage( 
  radioButtons("attr", "Name of Attribute",  c("BC","BA", "TIA" , "TBERV" , "TERV"), inline = TRUE), # Now outputs
  leafletOutput("mymap")   
  )
server <- function(input, output) {
  
  output$mymap <- renderLeaflet({   
    
    
    adjusted_data <- by_cnty_data[,c("PCnty", input$attr)]
    names(adjusted_data) <- c("NAME_2", "col_name")
    
    
    # get county level spatial polygons for the United States  
    counties <- getData("GADM", country = "USA", level = 2)
    
    # filter down to just New York State Counties
    counties <- counties[counties@data$NAME_1 == "New York",]
    bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
    pal <- colorBin("YlOrRd", domain = density, bins = bins)
    
    ## In our data we have St Lawrence but in our SP obkect we have Saint lawrence, so we 
    ## fix it by gsub()
    adjusted_data$NAME_2 = gsub("St Lawrence", "Saint Lawrence", adjusted_data$NAME_2)
    counties@data = left_join(counties@data, adjusted_data)
    
    
    
    
    state_popup <- paste0("<strong>County: </strong>", 
                          counties$NAME_2, 
                          "<br><strong>Attribute is : </strong>",  input$attr, 
                          "<br><strong> Value : </strong>", counties$col_name/100)
    
    counties %>% leaflet() %>% addTiles() %>% 
      addPolygons(
          fillColor = ~pal(col_name/100),
            weight = 2,
            opacity = 1,
            color = "blue", # we can change it or remove it
            dashArray = "3",
            fillOpacity = 0.7,
            highlight = highlightOptions(
              weight = 5,
              color = "#666",
              dashArray = "",
              fillOpacity = 0.7,
              bringToFront = TRUE), 
          popup = state_popup
      ) %>% 
      
      addLegend("bottomright", pal = pal, values = ~col_name/100,
          title = ,
          #labFormat = labelFormat(prefix = "$"),
          opacity = 1   
          )
    
    })
  
}
shinyApp(server = server, ui = ui)

Listening on http://127.0.0.1:4860
trying URL 'http://biogeo.ucdavis.edu/data/gadm2.8/rds/USA_adm2.rds'
Content type ' êãgþ' length 13943951 bytes (13.3 MB)
downloaded 13.3 MB

Joining, by = "NAME_2"
Joining, by = "NAME_2"
Joining, by = "NAME_2"

Combine Chroplothe and ShinyApp

# library(dplyr)
# MCD_cnty = renamed_data %>% filter(MDC == "Diabetes Mellitus") 
# MCD_cnty =   MCD_cnty[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")] %>% 
#   group_by(PCnty) %>% summarise(BC = sum(BC), BC = sum(BC), BA = sum(BA), 
#                                 TIA = sum(TIA), TBERV = sum(TBERV), TERV = sum(TERV))
# MCD_cnty

Now we map MDC

ui <- fluidPage( 
  selectInput("attr", "Name of MDC Category",  
               c("Diabetes Mellitus",
                 "Diseases And Disorders Of The Cardiovascular System", 
                 "Diseases And Disordes Of The Respiratory System" , 
                 "HIV Infection" , 
                 "Mental Diseases And Disorders", 
                 "Newborns And Other Neonates", 
                 "Substance Abuse")
               ), # Now outputs
  selectInput("var", "Name of Attribute",  c("BC","BA", "TIA" , "TBERV" , "TERV")),
  leafletOutput("mymap")   
  )
server <- function(input, output) {
  
  output$mymap <- renderLeaflet({   
    
    MCD_cnty = joined_data %>% filter(MDC == input$attr) 
    MCD_cnty = MCD_cnty %>% mutate( BC = BC*10^3/TBC, BA = BA*10^3/TBC, TIA = TIA*10^3/TBC, 
                                    TBERV = TBERV*10^3/TBC, TERV = TERV*10^3/TBC)
    MCD_cnty =   MCD_cnty[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")] %>% 
          group_by(PCnty) %>% summarise(BC = sum(BC), BA = sum(BA), 
                                TIA = sum(TIA), TBERV = sum(TBERV), TERV = sum(TERV)
                                )
    ## To keep it dafe: 
    #MCD_cnty = renamed_data %>% filter(MDC == input$attr) 
    #MCD_cnty =   MCD_cnty[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")] %>% 
    #      group_by(PCnty) %>% summarise(BC = sum(BC), BC = sum(BC), BA = sum(BA), 
    #                            TIA = sum(TIA), TBERV = sum(TBERV), TERV = sum(TERV))
    
    
    adjusted_data <- MCD_cnty[,c("PCnty", input$var)]
    names(adjusted_data) <- c("NAME_2", "col_name")
    
    
    # get county level spatial polygons for the United States  
    counties <- getData("GADM", country = "USA", level = 2)
    
    # filter down to just New York State Counties
    counties <- counties[counties@data$NAME_1 == "New York",]
    bins <- c(0, 25, 45, 60, 80, 170, 250, 400, 700, Inf)
    pal <- colorBin("YlOrRd", domain = density, bins = bins)
    
    ## In our data we have St Lawrence but in our SP obkect we have Saint lawrence, so we 
    ## fix it by gsub()
    adjusted_data$NAME_2 = gsub("St Lawrence", "Saint Lawrence", adjusted_data$NAME_2)
    counties@data = left_join(counties@data, adjusted_data)
    
    
    
    #pal <- brewer.pal(15, "YlGnBu")
    
    
    
    state_popup <- paste0("<strong>County: </strong>", 
                          counties$NAME_2, 
                          "<br><strong>MDC category : </strong>",  input$attr, 
                          "<br><strong> Value per 1K : </strong>", round(counties$col_name, 3) ) 
    
    counties %>% leaflet() %>% addTiles() %>% 
      addPolygons(
          fillColor = ~pal(col_name), 
            weight = 2,
            opacity = 1,
            color = "blue", # we can change it or remove it
            dashArray = "3",
            fillOpacity = 0.7,
            highlight = highlightOptions(
              weight = 5,
              color = "#666",
              dashArray = "",
              fillOpacity = 0.7,
              bringToFront = TRUE), 
          popup = state_popup
      ) %>% 
      
      addLegend("bottomright", pal = pal, values = ~col_name,
          title = ,
          #labFormat = labelFormat(prefix = "$"),
          opacity = 1   
          )
    
    })
  
}
shinyApp(server = server, ui = ui)

Listening on http://127.0.0.1:4860
Joining, by = "NAME_2"
Joining, by = "NAME_2"
Joining, by = "NAME_2"

ui <- fluidPage( 
  selectInput("attr", "Name of MDC Category",  
               c("Diabetes Mellitus",
                 "Diseases And Disorders Of The Cardiovascular System", 
                 "Diseases And Disordes Of The Respiratory System" , 
                 "HIV Infection" , 
                 "Mental Diseases And Disorders", 
                 "Newborns And Other Neonates", 
                 "Substance Abuse")
               ), # Now outputs
  selectInput("var", "Name of Attribute",  c("BC","BA", "TIA" , "TBERV" , "TERV")),
  leafletOutput("mymap")   
  )



server <- function(input, output) {
  
  output$mymap <- renderLeaflet({   
    
    MCD_cnty = joined_data %>% filter(MDC == input$attr) 
    MCD_cnty = MCD_cnty %>% mutate( BC = BC*10^3/TBC, BA = BA*10^3/TBC, TIA = TIA*10^3/TBC, 
                                    TBERV = TBERV*10^3/TBC, TERV = TERV*10^3/TBC)
    MCD_cnty =   MCD_cnty[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")] %>% 
          group_by(PCnty) %>% summarise(BC = sum(BC), BA = sum(BA), 
                                TIA = sum(TIA), TBERV = sum(TBERV), TERV = sum(TERV)
                                )
    ## To keep it dafe: 
    #MCD_cnty = renamed_data %>% filter(MDC == input$attr) 
    #MCD_cnty =   MCD_cnty[, c("PCnty", "BC","BA", "TIA" , "TBERV" , "TERV")] %>% 
    #      group_by(PCnty) %>% summarise(BC = sum(BC), BC = sum(BC), BA = sum(BA), 
    #                            TIA = sum(TIA), TBERV = sum(TBERV), TERV = sum(TERV))
    
    
    adjusted_data <- MCD_cnty[,c("PCnty", input$var)]
    names(adjusted_data) <- c("NAME_2", "col_name")
    
    
    # get county level spatial polygons for the United States  
    counties <- getData("GADM", country = "USA", level = 2)
    
    # filter down to just New York State Counties
    counties <- counties[counties@data$NAME_1 == "New York",]
    bins <- c(0, 25, 45, 60, 80, 170, 250, 400, 700, Inf)
    pal <- colorBin("YlOrRd", domain = density, bins = bins)
    
    ## In our data we have St Lawrence but in our SP obkect we have Saint lawrence, so we 
    ## fix it by gsub()
    adjusted_data$NAME_2 = gsub("St Lawrence", "Saint Lawrence", adjusted_data$NAME_2)
    counties@data = left_join(counties@data, adjusted_data)
    
    
    
    #pal <- brewer.pal(15, "YlGnBu")
    
    
    
    state_popup <- paste0("<strong>County: </strong>", 
                          counties$NAME_2, 
                          "<br><strong>MDC category : </strong>",  input$attr, 
                          "<br><strong> Value per 1K : </strong>", round(counties$col_name, 3) ) 
    
    counties %>% leaflet() %>% addTiles() %>% 
      addPolygons(
          fillColor = ~pal(col_name), 
            weight = 2,
            opacity = 1,
            color = "blue", # we can change it or remove it
            dashArray = "3",
            fillOpacity = 0.7,
            highlight = highlightOptions(
              weight = 5,
              color = "#666",
              dashArray = "",
              fillOpacity = 0.7,
              bringToFront = TRUE), 
          popup = state_popup
      ) %>% 
      
      addLegend("bottomright", pal = pal, values = ~col_name,
          title = ,
          #labFormat = labelFormat(prefix = "$"),
          opacity = 1   
          )
    
    })
  
}


shinyApp(server = server, ui = ui)

```

LS0tDQp0aXRsZTogIk1lZGljYWlkIENocm9uaWMgQ29uZGl0aW9ucywgSW5wYXRpZW50IEFkbWlzc2lvbnMgYW5kIEVtZXJnZW5jeSBSb29tIFZpc2l0cyBieSBaaXAgQ29kZTogQmVnaW5uaW5nIDIwMTIiDQpvdXRwdXQ6DQogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQNCiAgaHRtbF9kb2N1bWVudDogZGVmYXVsdA0KLS0tDQoNCg0KVXJsOiAgaHR0cHM6Ly9oZWFsdGguZGF0YS5ueS5nb3YvSGVhbHRoL01lZGljYWlkLUNocm9uaWMtQ29uZGl0aW9ucy1JbnBhdGllbnQtQWRtaXNzaW9ucy1hLzJ5Y2steGlzaw0KDQojIyMgU3VtbWFyeTogDQoqIENvbnRhaW5zIGluZm9ybWF0aW9uIG9uIHNlbGVjdGVkIGNocm9uaWMgaGVhbHRoIGNvbmRpdGlvbnMgDQoqIENvbmNlcm5zIHRoZSBNZWRpY2FpZCBwb3B1bGF0aW9uIGF0IHRoZSB6aXAgY29kZSBsZXZlbCANCiogUG9zdGluZyBGcmVxdWVuY3k6IEFubnVhbGx5DQoqIE9yZ2FuaXphdGlvbjoJT2ZmaWNlIG9mIFF1YWxpdHkgYW5kIFBhdGllbnQgU2FmZXR5DQoqIFRpbWUgUGVyaW9kCUJlZ2lubmluZyAyMDEyIHRvIDIwMTQNCiogR3JhbnVsYXJpdHk6CUhvc3BpdGFsDQoqIERhdGFzZXQgT3duZXI6IEJ1cmVhdSBvZiBIZWFsdGggSW5mb3JtYXRpY3MNCg0KDQojIyMgTm90ZXM6IA0KKiBUaGUgZGF0YSBpcyBydW4gb24gYWxsIE1lZGljYWlkIHJlY2lwaWVudHMgZHVyaW5nIGEgMTIgbW9udGggcGVyaW9kDQoqIENocm9uaWMgY29uZGl0aW9ucyBhcmUgaWRlbnRpZmllZCB0aHJvdWdoIHVzZSBvZiBzZXJ2aWNlcyBhbmQgcGhhcm1hY3kNCiogTWVkaWNhaWQgZW5yb2xsZWVzIGhhdmluZyBhIGNocm9uaWMgaGVhbHRoIGNvbmRpdGlvbiBvdXRzaWRlIG9mIHRoZSBzZXJ2aWNlIHBlcmlvZCwgYXJlIG5vdCByZWZsZWN0ZWQNCiogQW55IGNvbmRpdGlvbiB3aGVyZSB0aGUgbnVtYmVyIG9mIHVuaXF1ZSBiZW5lZmljaWFyaWVzIHdhcyBfXzIwX18gb3IgbGVzcyB3ZXJlIF9fc3VwcHJlc3NlZF9fLiANCg0KIyMjIERpbWVuc2lvbnMgYW5kIE90aGVyIFN0YXRpc3RpY3M6IA0KKiBSb3dzOiA5OC43Sw0KKiBDb2x1bW5zOiAxMQ0KDQpgYGB7ciBtZXNzYWdlID0gRkFMU0V9DQojc2V0d2QoIn4vRVItSW5wYXRpZW50LVZpc2l0aXMiKQ0KbGlicmFyeShzaGlueSkNCmxpYnJhcnkoZ2VvanNvbmlvKQ0KbGlicmFyeShnZ21hcCkNCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkoemlwY29kZSkNCmxpYnJhcnkoY2hvcm9wbGV0aHJNYXBzKQ0KbGlicmFyeShjaG9yb3BsZXRocikNCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KHBsb3RseSkNCmxpYnJhcnkobGVhZmxldCkNCmxpYnJhcnkoRFQpDQpsaWJyYXJ5KHNwKQ0KbGlicmFyeShyYXN0ZXIpDQpsaWJyYXJ5KG1hcHRvb2xzKQ0KbGlicmFyeShSQ29sb3JCcmV3ZXIpDQpsaWJyYXJ5KEdHYWxseSkNCmxpYnJhcnkoY29ycnBsb3QpDQpgYGANCg0KDQpgYGB7cn0NCm15ZGF0YSA9IHJlYWQuY3N2KCIuL0VSLURhdGFTZXQuY3N2IikNCm15ZGF0YSANCmBgYA0KDQoNCiMjIENvdW50eSBlbnJvbGxtZW50IG1pc3NpbmchDQoNCg0KYGBge3J9DQpyZW5hbWVkX2RhdGEgPSByZW5hbWUobXlkYXRhLCANCiAgICAgICAgICAgICAgICAgICAgICAgWmlwID0gWmlwLkNvZGUsIFBDbnR5ID0gUHJpbWFyeS5Db3VudHksIER1YWwgPSBEdWFsLkVsaWdpYmxlLCANCiAgICAgICAgICAgICAgICAgICAgICAgTURDID0gTWFqb3IuRGlhZ25vc3RpYy5DYXRlZ29yeSwgRURDID0gRXBpc29kZS5EaXNlYXNlLkNhdGVnb3J5LCANCiAgICAgICAgICAgICAgICAgICAgICBCQyA9IEJlbmVmaWNpYXJpZXMud2l0aC5Db25kaXRpb24sIA0KICAgICAgICAgICAgICAgICAgICAgIEJBID0gQmVuZWZpY2lhcmllcy53aXRoLkFkbWlzc2lvbnMsIA0KICAgICAgICAgICAgICAgICAgIFRJQSA9IFRvdGFsLklucGF0aWVudC5BZG1pc3Npb25zLCANCiAgICAgICAgICAgICAgICAgICBUQkVSViA9IEJlbmVmaWNpYXJpZXMud2l0aC5FUi5WaXNpdHMsIA0KICAgICAgICAgICAgICAgICAgIFRFUlYgPSBUb3RhbC5FUi5WaXNpdHMpDQoocmVuYW1lZF9kYXRhKQ0KDQpgYGANCg0KDQpgYGB7cn0NCihzdW1tYXJ5KHJlbmFtZWRfZGF0YVtjKCJEdWFsIiwgIkJDIiwgIkJBIiwgIlRJQSIsICJUQkVSViIsICJURVJWIildKSApDQpgYGANCg0KDQoNCg0KDQpgYGB7cn0NCm91dGxpZXJfb3V0X2RhdGEgPSBmaWx0ZXIocmVuYW1lZF9kYXRhLCAhQkMlaW4lIGJveHBsb3Quc3RhdHMoQkMpJG91dCwNCiAgICAgICAgICAgICAgICFCQSVpbiUgYm94cGxvdC5zdGF0cyhCQSkkb3V0LA0KICAgICAgICAgICAgICAgIVRJQSVpbiUgYm94cGxvdC5zdGF0cyhUSUEpJG91dCwNCiAgICAgICAgICAgICAgICFUQkVSViVpbiUgYm94cGxvdC5zdGF0cyhUQkVSVikkb3V0LA0KICAgICAgICAgICAgICAgIVRFUlYlaW4lIGJveHBsb3Quc3RhdHMoVEVSVikkb3V0DQogICAgICAgICAgICAgICApDQoNCnBsb3RfbHkob3V0bGllcl9vdXRfZGF0YSwgeCA9IH5ZZWFyLCB5ID0gfkJDLCAgdHlwZSA9ICdib3gnLCBuYW1lID0gIkJDIikgJT4lDQogIGFkZF90cmFjZSh5ID0gfkJBLCBuYW1lID0gIkJBIikgJT4lDQogIGFkZF90cmFjZSh5ID0gflRJQSwgbmFtZSA9ICJUSUEiKSAlPiUNCiAgYWRkX3RyYWNlKHkgPSB+VEJFUlYsIG5hbWUgPSAiVEJFUlYiKSAlPiUNCiAgYWRkX3RyYWNlKHkgPSB+VEVSViwgbmFtZSA9ICJURVJWIikgJT4lDQogIGxheW91dCh5YXhpcyA9IGxpc3QodGl0bGUgPSAnJyksIGJveG1vZGUgPSAnZ3JvdXAnKQ0KDQpgYGANCg0KDQpgYGB7cn0NCmNvbHVtbnMgPSBkYXRhLmZyYW1lKHJlbmFtZWRfZGF0YVsgLCAhbmFtZXMocmVuYW1lZF9kYXRhKSAlaW4lIGMoIlllYXIiLCAiTURDIiwgIkVEQyIsICJaaXAiLCAiUENudHkiLCAiRHVhbCIpIF0gKQ0KZ2dwYWlycyhjb2x1bW5zICkNCmBgYA0KDQoNCmBgYHtyfQ0KY29ycnBsb3QoICAgY29yKHJlbmFtZWRfZGF0YVtjKCJCQyIsICJCQSIsICJUSUEiLCAiVEJFUlYiLCAiVEVSViIpXSkgICkNCmBgYA0KDQoNCmBgYHtyfQ0KZF9zdGFuID0gYXMuZGF0YS5mcmFtZShzY2FsZShyZW5hbWVkX2RhdGFbYygiQkMiLCAiQkEiLCAiVElBIiwgIlRCRVJWIiwgIlRFUlYiKV0pKQ0KcmVzMWIgPSBmYWN0YW5hbChkX3N0YW4sIGZhY3RvcnMgPSAyLCByb3RhdGlvbiA9ICJub25lIiwgbmEuYWN0aW9uID0gbmEub21pdCkNCnJlczFiJGxvYWRpbmdzDQpgYGANCg0KYGBge3J9DQpzdW1tYXJ5KHJlbmFtZWRfZGF0YVs1XSkNCmBgYA0KYGBge3J9DQoNCmF4X2RhdGEgPSByZW5hbWVkX2RhdGENCmxldmVscyhheF9kYXRhJE1EQykgPC0gYygiRGlhYmV0ZXMiLCAiQ2FyZGlvdmFzY3VsYXIiLCAiUmVzcGlyYXRvcnkgIiwgDQogICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIkhJViIsICJNZW50YWwiLCAiTmV3Ym9ybnMiLCAiU3VidG5jLUFidXNlIikNCnBsb3RfbHkoYXhfZGF0YSwgeCA9IH5NREMpICU+JSANCiAgbGF5b3V0KHRpdGxlID0gIkZyZXF1ZW5jeSBvZiBFYWNoIENhdGVnb3IiLCANCiAgICAgICAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICcnKSwgeGF4aXMgPSBsaXN0KHRpdGxlID0gIiIsIHRpY2thbmdsZSA9IDQ1KSwgDQogICAgICAgICAgICAgICBtYXJnaW4gPSBsaXN0KGIgPSAyNTApKQ0KYGBgDQoNCg0KYGBge3J9DQpwbG90X2x5KHJlbmFtZWRfZGF0YSwgeCA9IH5NREMpICU+JSANCiAgbGF5b3V0KHRpdGxlID0gIkZyZXF1ZW5jeSBvZiBFYWNoIENhdGVnb3IiLCANCiAgICAgICAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICcnKSwgeGF4aXMgPSBsaXN0KHRpdGxlID0gIiIsIHRpY2thbmdsZSA9IDQ1KSwgDQogICAgICAgICAgICAgICBtYXJnaW4gPSBsaXN0KGIgPSAyNTApKQ0KYGBgDQoNCg0KDQoNCmBgYHtyfQ0KDQpNRENfRHVhbCA9IHJlbmFtZWRfZGF0YVssIGMoIk1EQyIsICJEdWFsIildICU+JSANCiAgZ3JvdXBfYnkoTURDLCBEdWFsKSAlPiUgc3VtbWFyaXNlKG4oKSkgDQpjb2xuYW1lcyhNRENfRHVhbCkgPSBjKCJNREMiLCAiRHVhbCIsICJGcmVxdWVuY3kiKQ0KbGV2ZWxzKE1EQ19EdWFsJE1EQykgPC0gYygiRGlhYmV0ZXMiLCAiQ2FyZGlvdmFzY3VsYXIiLCAiUmVzcGlyYXRvcnkgIiwgDQogICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIkhJViIsICJNZW50YWwiLCAiTmV3Ym9ybnMiLCAiU3VidG5jLUFidXNlIikNCnBsb3RfbHkoTURDX0R1YWwsIHggPSB+TURDLCB5ID0gfkZyZXF1ZW5jeSwgY29sb3IgPSB+RHVhbCkgJT4lIA0KbGF5b3V0KHRpdGxlID0gIkZyZXF1ZW5jeSB2cyBEdWFsIEVsaWdpYmxpdHkiLCANCiAgICAgICAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICcnKSwgeGF4aXMgPSBsaXN0KHRpdGxlID0gIiIsIHRpY2thbmdsZSA9IDQ1KSwgDQogICAgICAgICAgICAgICBtYXJnaW4gPSBsaXN0KGIgPSAyNTApKQ0KYGBgDQoNCmBgYHtyfQ0KDQpieV9EdWFsX2RhdGEgPSByZW5hbWVkX2RhdGFbLCBjKCJEdWFsIiwgIkJDIiwgIkJBIiwgIlRJQSIsICJUQkVSViIsICJURVJWIildICU+JSANCiAgZ3JvdXBfYnkoRHVhbCkgJT4lIA0KICAgICAgICBzdW1tYXJpc2UoIEJDID0gc3VtKEJDKSwgQkEgPSBzdW0oQkEpLCANCiAgICAgICAgICAgICAgICAgICBUSUEgPSBzdW0oVElBKSwgDQogICAgICAgICAgICAgICAgICAgVEJFUlYgPSBzdW0oVEJFUlYpLCANCiAgICAgICAgICAgICAgICAgICBURVJWID0gc3VtKFRFUlYpKQ0KdCA8LSBsaXN0KCAgZmFtaWx5ID0gInNhbnMgc2VyaWYiLCAgIHNpemUgPSAxNCwgICBjb2xvciA9ICdibHVlJykNCg0KcGxvdF9seShieV9EdWFsX2RhdGEsIHggPSB+RHVhbCwgeSA9IH5CQywgIHR5cGUgPSAnYmFyJywgbmFtZSA9ICJCQyIpICU+JSANCiAgYWRkX3RyYWNlKHkgPSB+QkEsIG5hbWUgPSAiQkEiKSAlPiUgDQogIGFkZF90cmFjZSh5ID0gflRJQSwgbmFtZSA9ICJUSUEiKSAlPiUgDQogIGFkZF90cmFjZSh5ID0gflRCRVJWLCBuYW1lID0gIlRCRVJWIikgJT4lIA0KICBhZGRfdHJhY2UoeSA9IH5URVJWLCBuYW1lID0gIlRFUlYiKSAlPiUgDQogIGxheW91dCggdGl0bGUgPSAiUG9wdWxhdGlvbiBDb3VudCIsIA0KICAgICAgICAgIGZvbnQgPSB0LCANCiAgICAgICAgICB5YXhpcyA9IGxpc3QodGl0bGUgPSAnJyksIHhheGlzID0gbGlzdCh0aXRsZSA9ICIiKSwgYmFybW9kZSA9ICdncm91cCcpIA0KYGBgDQoNCg0KDQoNCg0KYGBge3J9DQoNCnVpIDwtIGZsdWlkUGFnZSggDQogIHNlbGVjdElucHV0KCJjYXRlZyIsICJOYW1lIG9mIENhdGVnb3J5IiwNCiAgICAgICAgICAgICAgIGMoIkRpYWJldGVzIE1lbGxpdHVzIiAsDQogICAgICAgICAgICAgICAgICJEaXNlYXNlcyBBbmQgRGlzb3JkZXJzIE9mIFRoZSBDYXJkaW92YXNjdWxhciBTeXN0ZW0iLCANCiAgICAgICAgICAgICAgICAgIkRpc2Vhc2VzIEFuZCBEaXNvcmRlcyBPZiBUaGUgUmVzcGlyYXRvcnkgU3lzdGVtIiwgDQogICAgICAgICAgICAgICAgICJISVYgSW5mZWN0aW9uIiwgDQogICAgICAgICAgICAgICAgICJNZW50YWwgRGlzZWFzZXMgQW5kIERpc29yZGVycyIsDQogICAgICAgICAgICAgICAgICJOZXdib3JucyBBbmQgT3RoZXIgTmVvbmF0ZXMiLA0KICAgICAgICAgICAgICAgICAiU3Vic3RhbmNlIEFidXNlIiANCiAgICAgICAgICAgICAgICAgKSkgDQogICwgIyBOb3cgb3V0cHV0cw0KICBwbG90bHlPdXRwdXQoIm15X3Bsb3RfbmFtZSIpDQogIA0KIA0KICApDQoNCg0KIHNlcnZlciA8LSBmdW5jdGlvbihpbnB1dCwgb3V0cHV0KSB7DQogIA0KICBvdXRwdXQkbXlfcGxvdF9uYW1lIDwtIA0KICAgIA0KICAgIHJlbmRlclBsb3RseSh7ICAgDQogICAgICANCiAgICBNRENfRURDID0gcmVuYW1lZF9kYXRhWywgYygiTURDIiwgIkVEQyIpXSAlPiUgIGZpbHRlcihNREMgPT0gaW5wdXQkY2F0ZWcgICkNCiAgICBNRENfRURDIDwtIGxhcHBseShNRENfRURDLCBmYWN0b3IpDQogICAgRURDX2ZhY3RvciA9IGFzLmZhY3RvciggdW5saXN0KE1EQ19FRENbMl0pICApDQogICAgZGZfRURDID0gZGF0YS5mcmFtZSh0YWJsZShFRENfZmFjdG9yKSkNCiAgICBuYW1lcyhkZl9FREMpIDwtIGMoIkVEQ19DYXRlZ29yeSIsICJGcmVxIikNCiAgICANCiAgICBwbG90X2x5KGRmX0VEQywgeCA9IH5FRENfQ2F0ZWdvcnksIHkgPSB+RnJlcSwgdHlwZSA9ICdiYXInLCAgaW5zaWRldGV4dGZvbnQgPSBsaXN0KGNvbG9yID0gJyNGRkZGRkYnKSwgaG92ZXJpbmZvID0gJ3RleHQnKSAlPiUgDQogIGxheW91dCggdGl0bGUgPSBwYXN0ZSgiQ2F0ZWdvcnk6ICIsIGlucHV0JGNhdGVnKSwgDQogICAgICAgICAgeGF4aXMgPSBsaXN0KHRpdGxlID0gIiIsIHRpY2thbmdsZSA9IDQ1KSwgeWF4aXMgPSBsaXN0KHRpdGxlID0gIiIpLCANCiAgICAgICAgICBtYXJnaW4gPSBsaXN0KGIgPSAyMDApLCANCiAgICAgICAgICBmb250ID0gdCAgICkNCiAgICAgIH0pDQogIA0KIH0NCg0KDQogc2hpbnlBcHAoc2VydmVyID0gc2VydmVyLCB1aSA9IHVpKQ0KDQoNCmBgYA0KDQoNCg0KDQoNCg0KDQoNCg0KYGBge3J9DQoNCg0KDQoNCnJ1bkFwcChsaXN0KA0KICB1aSA9IGJhc2ljUGFnZSgNCiAgICAjaDIoJ1RoZSBhdHRydWJ1dGVzIHRvIHNlbGVjdCcpLA0KICAgIGNoZWNrYm94R3JvdXBJbnB1dCgiY29sdW1ucyIsIlNlbGVjdCBDb2x1bW5zIiwNCiAgICAgICAgICAgICAgICAgICAgICAgY2hvaWNlcyA9IGMoIkJDIiwgIkJBIiwgIlRJQSIsICJUQkVSViIsICJURVJWIiksIGlubGluZSA9IFQpLA0KICAgIHBsb3RseU91dHB1dCgibXlfcGxvdF9uYW1lIikNCg0KDQogICksDQogIHNlcnZlciA9IGZ1bmN0aW9uKGlucHV0LCBvdXRwdXQpIHsNCg0KDQogICAgb3V0cHV0JG15X3Bsb3RfbmFtZSA8LSByZW5kZXJQbG90bHkoew0KDQoNCiAgICAgIGlmKCBsZW5ndGgoaW5wdXQkY29sdW1ucykgPT0gMCApew0KICAgICAgICBwbG90X2x5KCkgJT4lIGxheW91dCgpDQogICAgICAgICNkZnplcm8gPC0gYnlfTURDX2RhdGFbLGMoIk1EQyIsICJCQyIpXQ0KICAgICAgICAjbmFtZXMoZGZ6ZXJvKSA8LSBjKCJNREMiLCAiQkMiKQ0KICAgICAgICAjcGxvdF9seShkZnplcm8sIHggPSB+TURDLCB5ID0gfkJDLCAgdHlwZSA9ICdiYXInLCBuYW1lID0gIlRFUlYiKSAlPiUNCiAgICAgICAgIyAgbGF5b3V0KHRpdGxlID0gIlRvdGFsIGNvdW50IG9mIGVhY2ggQ2F0ZWdvciIsDQogICAgICAgICMgICAgICB5YXhpcyA9IGxpc3QodGl0bGUgPSAnJyksIHhheGlzID0gbGlzdCh0aXRsZSA9ICIiKSwgYmFybW9kZSA9ICdncm91cCcpDQoNCiAgICAgIH0NCg0KDQogICAgICAjaWYobGVuZ3RoKGlucHV0JGNvbHVtbnMpID09IDEpew0KICAgICAgIyAgY29scyA8LSBjKCJNREMiLCBpbnB1dCRjb2x1bW5zKQ0KICAgICAgIyAgZGYgPC0gZGF0YS5mcmFtZShieV9NRENfZGF0YVssY29sc10pDQogICAgICAjICBuYW1lcyhkZikgPC0gYygiTURDIiwgImlucHV0X2NvbCIpDQogICAgICAjICBwbG90X2x5KGRmLCB4ID0gfk1EQywgeSA9IH5pbnB1dF9jb2wsICB0eXBlID0gJ2JhcicsIG5hbWUgPSAiVEVSViIpICU+JQ0KICAgICAgIyAgICBsYXlvdXQodGl0bGUgPSAiVG90YWwgY291bnQgb2YgZWFjaCBDYXRlZ29yIiwNCiAgICAgICMgICAgICAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICcnKSwgeGF4aXMgPSBsaXN0KHRpdGxlID0gIiIsIHRpY2thbmdsZSA9IC05MCksDQogICAgICAjICAgICAgICBtYXJnaW4gPSBsaXN0KGIgPSAyMDApLCBiYXJtb2RlID0gJ2dyb3VwJykNCg0KICAgICAgI30NCiAgICAgIGVsc2V7DQogICAgICAgIGNvbHMgPC0gYygiTURDIiwgaW5wdXQkY29sdW1ucykNCiAgICAgICAgZGYgPC0gZGF0YS5mcmFtZShieV9NRENfZGF0YSkNCiAgICAgICAgbmFtZXMoZGYpIDwtIGMoIk1EQyIsICJCQyIsICJCQSIsICJUSUEiLCAiVEJFUlYiLCAiVEVSViIpDQogICAgICAgIGRmJE1EQyA8LSBmYWN0b3IoZGYkTURDLCBsZXZlbHMgPSBkZltbIk1EQyJdXSkNCg0KICAgICAgICBwID0gcGxvdF9seShkZiwgIHggPSB+TURDLCAgdHlwZSA9ICdiYXInLCBuYW1lID0gIkJDIikgICAlPiUgDQogICAgICAgICAgbGF5b3V0KCB0aXRsZSA9ICJUb3RhbCBjb3VudCBvZiBlYWNoIENhdGVnb3IiLA0KICAgICAgICAgICAgICAgeWF4aXMgPSBsaXN0KHRpdGxlID0gJycpLCB4YXhpcyA9IGxpc3QodGl0bGUgPSAiIiwgdGlja2FuZ2xlID0gNDUpLA0KICAgICAgICAgICAgICAgbWFyZ2luID0gbGlzdChiID0gMjAwKSwNCiAgICAgICAgICAgICAgIGJhcm1vZGUgPSAnZ3JvdXAnKQ0KICAgICAgICBpZiAoIkJDIiAlaW4lIGNvbHMpeyAgcCA9IGFkZF90cmFjZShwLCB5ID0gfkJDLCBuYW1lID0gIkJDIil9DQogICAgICAgIGlmICgiQkEiICVpbiUgY29scyl7ICBwID0gYWRkX3RyYWNlKHAsIHkgPSB+QkEsIG5hbWUgPSAiQkEiKX0NCiAgICAgICAgaWYgKCAiVElBIiAlaW4lIGNvbHMpeyBwID0gYWRkX3RyYWNlKHAsIHkgPSB+VElBLCBuYW1lID0gIlRJQSIpIH0NCiAgICAgICAgaWYgKCAiVEJFUlYiICVpbiUgY29scyl7IHAgPSBhZGRfdHJhY2UocCwgeSA9IH5UQkVSViwgbmFtZSA9ICJUQkVSViIpIH0NCiAgICAgICAgaWYgKCAiVEVSViIgJWluJSBjb2xzKXsgcCA9IGFkZF90cmFjZShwLCB5ID0gflRFUlYsIG5hbWUgPSAiVEVSViIpIH0NCg0KICAgICAgICBwDQoNCiAgICAgIH0NCg0KDQogICAgfSkNCg0KICB9DQopKQ0KYGBgDQoNCg0KDQpgYGB7cn0NCmRldGFpbGVkX2RhdGEgPSByZWFkLmNzdigiTmV3RGF0YV9EZXRhaWxlZC5jc3YiKQ0KZGV0YWlsZWRfZGF0YQ0KYGBgDQoNCmBgYHtyfQ0Kc2VsZWN0ZWRfY29sdW1ucyA9IGRldGFpbGVkX2RhdGFbLCBjKCJZZWFyIiwgIlppcC5Db2RlIiwgIkNvdW50eSIsICJUb3RhbC5CZW5lZmljaWFyaWVzIildICU+JSANCiAgICAgICAgcmVuYW1lKFppcCA9IFppcC5Db2RlLCBQQ250eSA9IENvdW50eSwgVEIgPSBUb3RhbC5CZW5lZmljaWFyaWVzKQ0Kam9pbmVkX2RhdGEgPSBpbm5lcl9qb2luKHJlbmFtZWRfZGF0YSwgc2VsZWN0ZWRfY29sdW1ucykNCg0KY250eV9wb3BsdWxhdGlvbiA9IGRldGFpbGVkX2RhdGFbLCBjKCJDb3VudHkiLCAgIlRvdGFsLkJlbmVmaWNpYXJpZXMiKV0gJT4lIA0KICBncm91cF9ieShDb3VudHkpICU+JSBzdW1tYXJpc2UoVEJDID0gc3VtKFRvdGFsLkJlbmVmaWNpYXJpZXMpKSAlPiUgDQogICAgcmVuYW1lKFBDbnR5ID0gQ291bnR5KQ0KDQpqb2luZWRfZGF0YSA9IGlubmVyX2pvaW4oam9pbmVkX2RhdGEsIGNudHlfcG9wbHVsYXRpb24pDQpoZWFkKGpvaW5lZF9kYXRhKQ0KYGBgDQoNCg0KDQoNCg0KDQpgYGB7cn0NCmJ5X2NudHlfZGF0YSA9IHJlbmFtZWRfZGF0YVssIGMoIlBDbnR5IiwgIkJDIiwiQkEiLCAiVElBIiAsICJUQkVSViIgLCAiVEVSViIpXSU+JSANCiAgZ3JvdXBfYnkoUENudHkpICU+JSANCiAgICAgICAgc3VtbWFyaXNlKCBCQyA9IHN1bShCQyksIEJBID0gc3VtKEJBKSwgDQogICAgICAgICAgICAgICAgICAgVElBID0gc3VtKFRJQSksIA0KICAgICAgICAgICAgICAgICAgIFRCRVJWID0gc3VtKFRCRVJWKSwgDQogICAgICAgICAgICAgICAgICAgVEVSViA9IHN1bShURVJWKSkNCihieV9jbnR5X2RhdGEpDQoNCmBgYA0KDQojIyMgQ29tYmluZSBDaHJvcGxvdGhlIGFuZCBTaGlueUFwcA0KDQpgYGB7cn0NCg0KdWkgPC0gZmx1aWRQYWdlKCANCiAgcmFkaW9CdXR0b25zKCJhdHRyIiwgIk5hbWUgb2YgQXR0cmlidXRlIiwgIGMoIkJDIiwiQkEiLCAiVElBIiAsICJUQkVSViIgLCAiVEVSViIpLCBpbmxpbmUgPSBUUlVFKSwgIyBOb3cgb3V0cHV0cw0KICBsZWFmbGV0T3V0cHV0KCJteW1hcCIpICAgDQogICkNCg0KDQoNCnNlcnZlciA8LSBmdW5jdGlvbihpbnB1dCwgb3V0cHV0KSB7DQogIA0KICBvdXRwdXQkbXltYXAgPC0gcmVuZGVyTGVhZmxldCh7ICAgDQogICAgDQogICAgDQogICAgYWRqdXN0ZWRfZGF0YSA8LSBieV9jbnR5X2RhdGFbLGMoIlBDbnR5IiwgaW5wdXQkYXR0cildDQogICAgbmFtZXMoYWRqdXN0ZWRfZGF0YSkgPC0gYygiTkFNRV8yIiwgImNvbF9uYW1lIikNCiAgICANCiAgICANCiAgICAjIGdldCBjb3VudHkgbGV2ZWwgc3BhdGlhbCBwb2x5Z29ucyBmb3IgdGhlIFVuaXRlZCBTdGF0ZXMgIA0KICAgIGNvdW50aWVzIDwtIGdldERhdGEoIkdBRE0iLCBjb3VudHJ5ID0gIlVTQSIsIGxldmVsID0gMikNCiAgICANCiAgICAjIGZpbHRlciBkb3duIHRvIGp1c3QgTmV3IFlvcmsgU3RhdGUgQ291bnRpZXMNCiAgICBjb3VudGllcyA8LSBjb3VudGllc1tjb3VudGllc0BkYXRhJE5BTUVfMSA9PSAiTmV3IFlvcmsiLF0NCiAgICBiaW5zIDwtIGMoMCwgMTAsIDIwLCA1MCwgMTAwLCAyMDAsIDUwMCwgMTAwMCwgSW5mKQ0KICAgIHBhbCA8LSBjb2xvckJpbigiWWxPclJkIiwgZG9tYWluID0gZGVuc2l0eSwgYmlucyA9IGJpbnMpDQogICAgDQogICAgIyMgSW4gb3VyIGRhdGEgd2UgaGF2ZSBTdCBMYXdyZW5jZSBidXQgaW4gb3VyIFNQIG9ia2VjdCB3ZSBoYXZlIFNhaW50IGxhd3JlbmNlLCBzbyB3ZSANCiAgICAjIyBmaXggaXQgYnkgZ3N1YigpDQogICAgYWRqdXN0ZWRfZGF0YSROQU1FXzIgPSBnc3ViKCJTdCBMYXdyZW5jZSIsICJTYWludCBMYXdyZW5jZSIsIGFkanVzdGVkX2RhdGEkTkFNRV8yKQ0KICAgIGNvdW50aWVzQGRhdGEgPSBsZWZ0X2pvaW4oY291bnRpZXNAZGF0YSwgYWRqdXN0ZWRfZGF0YSkNCiAgICANCiAgICANCiAgICANCiAgICANCiAgICBzdGF0ZV9wb3B1cCA8LSBwYXN0ZTAoIjxzdHJvbmc+Q291bnR5OiA8L3N0cm9uZz4iLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgY291bnRpZXMkTkFNRV8yLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIjxicj48c3Ryb25nPkF0dHJpYnV0ZSBpcyA6IDwvc3Ryb25nPiIsICBpbnB1dCRhdHRyLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIjxicj48c3Ryb25nPiBWYWx1ZSA6IDwvc3Ryb25nPiIsIGNvdW50aWVzJGNvbF9uYW1lLzEwMCkNCiAgICANCiAgICBjb3VudGllcyAlPiUgbGVhZmxldCgpICU+JSBhZGRUaWxlcygpICU+JSANCiAgICAgIGFkZFBvbHlnb25zKA0KICAgICAgICAgIGZpbGxDb2xvciA9IH5wYWwoY29sX25hbWUvMTAwKSwNCiAgICAgICAgICAgIHdlaWdodCA9IDIsDQogICAgICAgICAgICBvcGFjaXR5ID0gMSwNCiAgICAgICAgICAgIGNvbG9yID0gImJsdWUiLCAjIHdlIGNhbiBjaGFuZ2UgaXQgb3IgcmVtb3ZlIGl0DQogICAgICAgICAgICBkYXNoQXJyYXkgPSAiMyIsDQogICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDAuNywNCiAgICAgICAgICAgIGhpZ2hsaWdodCA9IGhpZ2hsaWdodE9wdGlvbnMoDQogICAgICAgICAgICAgIHdlaWdodCA9IDUsDQogICAgICAgICAgICAgIGNvbG9yID0gIiM2NjYiLA0KICAgICAgICAgICAgICBkYXNoQXJyYXkgPSAiIiwNCiAgICAgICAgICAgICAgZmlsbE9wYWNpdHkgPSAwLjcsDQogICAgICAgICAgICAgIGJyaW5nVG9Gcm9udCA9IFRSVUUpLCANCiAgICAgICAgICBwb3B1cCA9IHN0YXRlX3BvcHVwDQogICAgICApICU+JSANCiAgICAgIA0KICAgICAgYWRkTGVnZW5kKCJib3R0b21yaWdodCIsIHBhbCA9IHBhbCwgdmFsdWVzID0gfmNvbF9uYW1lLzEwMCwNCiAgICAgICAgICB0aXRsZSA9ICwNCiAgICAgICAgICAjbGFiRm9ybWF0ID0gbGFiZWxGb3JtYXQocHJlZml4ID0gIiQiKSwNCiAgICAgICAgICBvcGFjaXR5ID0gMSAgIA0KICAgICAgICAgICkNCiAgICANCiAgICB9KQ0KICANCn0NCg0KDQpzaGlueUFwcChzZXJ2ZXIgPSBzZXJ2ZXIsIHVpID0gdWkpDQoNCg0KYGBgDQoNCg0KDQoNCiMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIw0KDQojIyMgTm93IHdlIG1hcCBNREMgDQoNCmBgYHtyfQ0KIyBsaWJyYXJ5KGRwbHlyKQ0KIyBNQ0RfY250eSA9IHJlbmFtZWRfZGF0YSAlPiUgZmlsdGVyKE1EQyA9PSAiRGlhYmV0ZXMgTWVsbGl0dXMiKSANCiMgTUNEX2NudHkgPSAgIE1DRF9jbnR5WywgYygiUENudHkiLCAiQkMiLCJCQSIsICJUSUEiICwgIlRCRVJWIiAsICJURVJWIildICU+JSANCiMgICBncm91cF9ieShQQ250eSkgJT4lIHN1bW1hcmlzZShCQyA9IHN1bShCQyksIEJDID0gc3VtKEJDKSwgQkEgPSBzdW0oQkEpLCANCiMgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBUSUEgPSBzdW0oVElBKSwgVEJFUlYgPSBzdW0oVEJFUlYpLCBURVJWID0gc3VtKFRFUlYpKQ0KIyBNQ0RfY250eQ0KYGBgDQoNCg0KDQoNCg0KYGBge3J9DQoNCnVpIDwtIGZsdWlkUGFnZSggDQogIHNlbGVjdElucHV0KCJhdHRyIiwgIk5hbWUgb2YgTURDIENhdGVnb3J5IiwgIA0KICAgICAgICAgICAgICAgYygiRGlhYmV0ZXMgTWVsbGl0dXMiLA0KICAgICAgICAgICAgICAgICAiRGlzZWFzZXMgQW5kIERpc29yZGVycyBPZiBUaGUgQ2FyZGlvdmFzY3VsYXIgU3lzdGVtIiwgDQogICAgICAgICAgICAgICAgICJEaXNlYXNlcyBBbmQgRGlzb3JkZXMgT2YgVGhlIFJlc3BpcmF0b3J5IFN5c3RlbSIgLCANCiAgICAgICAgICAgICAgICAgIkhJViBJbmZlY3Rpb24iICwgDQogICAgICAgICAgICAgICAgICJNZW50YWwgRGlzZWFzZXMgQW5kIERpc29yZGVycyIsIA0KICAgICAgICAgICAgICAgICAiTmV3Ym9ybnMgQW5kIE90aGVyIE5lb25hdGVzIiwgDQogICAgICAgICAgICAgICAgICJTdWJzdGFuY2UgQWJ1c2UiKQ0KICAgICAgICAgICAgICAgKSwgIyBOb3cgb3V0cHV0cw0KICBzZWxlY3RJbnB1dCgidmFyIiwgIk5hbWUgb2YgQXR0cmlidXRlIiwgIGMoIkJDIiwiQkEiLCAiVElBIiAsICJUQkVSViIgLCAiVEVSViIpKSwNCiAgbGVhZmxldE91dHB1dCgibXltYXAiKSAgIA0KICApDQoNCg0KDQpzZXJ2ZXIgPC0gZnVuY3Rpb24oaW5wdXQsIG91dHB1dCkgew0KICANCiAgb3V0cHV0JG15bWFwIDwtIHJlbmRlckxlYWZsZXQoeyAgIA0KICAgIA0KICAgIE1DRF9jbnR5ID0gam9pbmVkX2RhdGEgJT4lIGZpbHRlcihNREMgPT0gaW5wdXQkYXR0cikgDQogICAgTUNEX2NudHkgPSBNQ0RfY250eSAlPiUgbXV0YXRlKCBCQyA9IEJDKjEwXjMvVEJDLCBCQSA9IEJBKjEwXjMvVEJDLCBUSUEgPSBUSUEqMTBeMy9UQkMsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgVEJFUlYgPSBUQkVSVioxMF4zL1RCQywgVEVSViA9IFRFUlYqMTBeMy9UQkMpDQogICAgTUNEX2NudHkgPSAgIE1DRF9jbnR5WywgYygiUENudHkiLCAiQkMiLCJCQSIsICJUSUEiICwgIlRCRVJWIiAsICJURVJWIildICU+JSANCiAgICAgICAgICBncm91cF9ieShQQ250eSkgJT4lIHN1bW1hcmlzZShCQyA9IHN1bShCQyksIEJBID0gc3VtKEJBKSwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIFRJQSA9IHN1bShUSUEpLCBUQkVSViA9IHN1bShUQkVSViksIFRFUlYgPSBzdW0oVEVSVikNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICMjIFRvIGtlZXAgaXQgZGFmZTogDQogICAgI01DRF9jbnR5ID0gcmVuYW1lZF9kYXRhICU+JSBmaWx0ZXIoTURDID09IGlucHV0JGF0dHIpIA0KICAgICNNQ0RfY250eSA9ICAgTUNEX2NudHlbLCBjKCJQQ250eSIsICJCQyIsIkJBIiwgIlRJQSIgLCAiVEJFUlYiICwgIlRFUlYiKV0gJT4lIA0KICAgICMgICAgICBncm91cF9ieShQQ250eSkgJT4lIHN1bW1hcmlzZShCQyA9IHN1bShCQyksIEJDID0gc3VtKEJDKSwgQkEgPSBzdW0oQkEpLCANCiAgICAjICAgICAgICAgICAgICAgICAgICAgICAgICAgIFRJQSA9IHN1bShUSUEpLCBUQkVSViA9IHN1bShUQkVSViksIFRFUlYgPSBzdW0oVEVSVikpDQogICAgDQogICAgDQogICAgYWRqdXN0ZWRfZGF0YSA8LSBNQ0RfY250eVssYygiUENudHkiLCBpbnB1dCR2YXIpXQ0KICAgIG5hbWVzKGFkanVzdGVkX2RhdGEpIDwtIGMoIk5BTUVfMiIsICJjb2xfbmFtZSIpDQogICAgDQogICAgDQogICAgIyBnZXQgY291bnR5IGxldmVsIHNwYXRpYWwgcG9seWdvbnMgZm9yIHRoZSBVbml0ZWQgU3RhdGVzICANCiAgICBjb3VudGllcyA8LSBnZXREYXRhKCJHQURNIiwgY291bnRyeSA9ICJVU0EiLCBsZXZlbCA9IDIpDQogICAgDQogICAgIyBmaWx0ZXIgZG93biB0byBqdXN0IE5ldyBZb3JrIFN0YXRlIENvdW50aWVzDQogICAgY291bnRpZXMgPC0gY291bnRpZXNbY291bnRpZXNAZGF0YSROQU1FXzEgPT0gIk5ldyBZb3JrIixdDQogICAgYmlucyA8LSBjKDAsIDI1LCA0NSwgNjAsIDgwLCAxNzAsIDI1MCwgNDAwLCA3MDAsIEluZikNCiAgICBwYWwgPC0gY29sb3JCaW4oIllsT3JSZCIsIGRvbWFpbiA9IGRlbnNpdHksIGJpbnMgPSBiaW5zKQ0KICAgIA0KICAgICMjIEluIG91ciBkYXRhIHdlIGhhdmUgU3QgTGF3cmVuY2UgYnV0IGluIG91ciBTUCBvYmtlY3Qgd2UgaGF2ZSBTYWludCBsYXdyZW5jZSwgc28gd2UgDQogICAgIyMgZml4IGl0IGJ5IGdzdWIoKQ0KICAgIGFkanVzdGVkX2RhdGEkTkFNRV8yID0gZ3N1YigiU3QgTGF3cmVuY2UiLCAiU2FpbnQgTGF3cmVuY2UiLCBhZGp1c3RlZF9kYXRhJE5BTUVfMikNCiAgICBjb3VudGllc0BkYXRhID0gbGVmdF9qb2luKGNvdW50aWVzQGRhdGEsIGFkanVzdGVkX2RhdGEpDQogICAgDQogICAgDQogICAgDQogICAgI3BhbCA8LSBicmV3ZXIucGFsKDE1LCAiWWxHbkJ1IikNCiAgICANCiAgICANCiAgICANCiAgICBzdGF0ZV9wb3B1cCA8LSBwYXN0ZTAoIjxzdHJvbmc+Q291bnR5OiA8L3N0cm9uZz4iLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgY291bnRpZXMkTkFNRV8yLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIjxicj48c3Ryb25nPk1EQyBjYXRlZ29yeSA6IDwvc3Ryb25nPiIsICBpbnB1dCRhdHRyLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgIjxicj48c3Ryb25nPiBWYWx1ZSBwZXIgMUsgOiA8L3N0cm9uZz4iLCByb3VuZChjb3VudGllcyRjb2xfbmFtZSwgMykgKSANCiAgICANCiAgICBjb3VudGllcyAlPiUgbGVhZmxldCgpICU+JSBhZGRUaWxlcygpICU+JSANCiAgICAgIGFkZFBvbHlnb25zKA0KICAgICAgICAgIGZpbGxDb2xvciA9IH5wYWwoY29sX25hbWUpLCANCiAgICAgICAgICAgIHdlaWdodCA9IDIsDQogICAgICAgICAgICBvcGFjaXR5ID0gMSwNCiAgICAgICAgICAgIGNvbG9yID0gImJsdWUiLCAjIHdlIGNhbiBjaGFuZ2UgaXQgb3IgcmVtb3ZlIGl0DQogICAgICAgICAgICBkYXNoQXJyYXkgPSAiMyIsDQogICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDAuNywNCiAgICAgICAgICAgIGhpZ2hsaWdodCA9IGhpZ2hsaWdodE9wdGlvbnMoDQogICAgICAgICAgICAgIHdlaWdodCA9IDUsDQogICAgICAgICAgICAgIGNvbG9yID0gIiM2NjYiLA0KICAgICAgICAgICAgICBkYXNoQXJyYXkgPSAiIiwNCiAgICAgICAgICAgICAgZmlsbE9wYWNpdHkgPSAwLjcsDQogICAgICAgICAgICAgIGJyaW5nVG9Gcm9udCA9IFRSVUUpLCANCiAgICAgICAgICBwb3B1cCA9IHN0YXRlX3BvcHVwDQogICAgICApICU+JSANCiAgICAgIA0KICAgICAgYWRkTGVnZW5kKCJib3R0b21yaWdodCIsIHBhbCA9IHBhbCwgdmFsdWVzID0gfmNvbF9uYW1lLA0KICAgICAgICAgIHRpdGxlID0gLA0KICAgICAgICAgICNsYWJGb3JtYXQgPSBsYWJlbEZvcm1hdChwcmVmaXggPSAiJCIpLA0KICAgICAgICAgIG9wYWNpdHkgPSAxICAgDQogICAgICAgICAgKQ0KICAgIA0KICAgIH0pDQogIA0KfQ0KDQoNCnNoaW55QXBwKHNlcnZlciA9IHNlcnZlciwgdWkgPSB1aSkNCg0KDQpgYGANCg==